Post-ABS Testing

Load some packages that we’ll need to use to do these calculations:

library(tidyverse)
library(gifski)
library(ggraph)
library(here)
library(igraph)
library(tnet) # for the closeness function described here: https://toreopsahl.com/2010/03/20/closeness-centrality-in-networks-with-disconnected-components/
source(here("modelFunction_rewiring.R"))

1. Run the model once

# Define parameters
N = 50
mnSocExp = 0.3
n.removed = 10
baseline.in = 10
baseline.out = 5
mod00 = -0.4
mod01 = 0.2
mod10 = -0.2
mod11 = 0.4
coefBereavement = 1

modelGraphs <- runModel(N = N, # Nodes in the network
                        mnSocExp = mnSocExp,
                        n.removed = n.removed,
                        baseline.in = baseline.in,
                        baseline.out = baseline.out,
                        mod00 = mod00, 
                        mod11 = mod11, 
                        mod10 = mod10, 
                        mod01 = mod01,
                        coefBereavement = coefBereavement)$graphs

2. Do individuals have differentiable degrees over time?

df <- lapply(modelGraphs, degree) %>%
  do.call(rbind, .) %>%
  as.data.frame() %>%
  mutate(timestep = 1:nrow(.)) %>%
  pivot_longer(cols = -timestep, names_to = "id", values_to = "degree") %>%
  group_by(id) %>%
  mutate(initDegree = degree[1]) %>%
  ungroup() %>%
  mutate(id = as.numeric(stringr::str_remove(id, "V")))

## Warning in (function (..., deparse.level = 1) : number of columns of result is
## not a multiple of vector length (arg 11)

df %>%
  ggplot(aes(x = timestep, y = degree, col = initDegree, group = id))+
  geom_line()+
  scale_color_viridis_c()

# yes, we definitely see some individual differences in degree over time. The strength of this effect depends on mnSocExp.

3. Trends for many model runs

First, I run the model 100 times and compute the network measures for each of the model runs.

Now, I can make some plots to detect general trends in what happens to the network after removal/rewiring.

# Time slice numbers for line placement
back1 <- which(names(modelGraphs) == "back1") 
removed <- which(names(modelGraphs) == "removed")
rewired <- which(names(modelGraphs) == "rewired")

There’s no overall pattern to the effect of loss or rewiring on the network density. Presumably, if loss or rewiring does affect density, the extent of the effect will depend on which individuals were removed, or on some other factor. It isn’t generalizable.

In general, mean distance increases when individuals are removed, though it looks like there’s a lot of variation in the extent of the increase, and there are some cases where it decreases.

Modularity generally increases when individuals are removed and declines again with rewiring, but that’s not universally the case.

4. Relationship between removed nodes and network-level measures

## Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if `.name_repair` is omitted as of tibble 2.0.0.
## Using compatibility `.name_repair`.
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was generated.

A few sanity checks:

What about the ratio between the first and second changes? Aka: what percentage of the loss/gain is recovered by the rewiring?

## Warning in log(ratio): NaNs produced

## Warning in log(ratio): NaNs produced

## Warning in log(ratio): NaNs produced

## Warning: Removed 968 rows containing non-finite values (stat_smooth).

## Warning: Removed 943 rows containing missing values (geom_point).

## Warning in log(ratio): NaNs produced

## Warning in log(ratio): NaNs produced

## Warning in log(ratio): NaNs produced

## Warning: Removed 968 rows containing non-finite values (stat_smooth).

## Warning: Removed 943 rows containing missing values (geom_point).

## Warning in log(ratio): NaNs produced

## Warning in log(ratio): NaNs produced

## Warning in log(ratio): NaNs produced

## Warning: Removed 968 rows containing non-finite values (stat_smooth).

## Warning: Removed 943 rows containing missing values (geom_point).

## Warning: Removed 25 rows containing non-finite values (stat_smooth).

## Warning: Removed 25 rows containing non-finite values (stat_smooth).

## Warning: Removed 25 rows containing non-finite values (stat_smooth).

Gain vs. keep edges

What proportion of previous edges did bereaved individuals keep? And did it change by how bereaved they were?